home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / Splines.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-07-07  |  8.3 KB  |  224 lines  |  [.Ob./.Ob4]
  1. Syntax10.Scn.Fnt
  2. MODULE Splines;  (*NW 3.11.90 / 1.2.92*)
  3.     IMPORT Display, Files, Printer, Oberon, Graphics, GraphicFrames;
  4.     CONST N = 20;
  5.     TYPE Spline* = POINTER TO SplineDesc;
  6.         SplineDesc* = RECORD (Graphics.ObjectDesc)
  7.                 n*: INTEGER; open*: BOOLEAN;
  8.                 u*, v*: ARRAY N OF INTEGER
  9.             END ;
  10.         RealVector = ARRAY N OF REAL;
  11.         Poly = RECORD a, b, c, d, t: REAL END ;
  12.         PolyVector = ARRAY N OF Poly;
  13.     VAR method*: Graphics.Method;
  14.     PROCEDURE mark(f: GraphicFrames.Frame; col, x0, y0: INTEGER; sp: Spline);
  15.         VAR i, n, x, y: INTEGER;
  16.     BEGIN i := 1;
  17.         IF sp.open THEN n := sp.n ELSE n := sp.n-1 END ;
  18.         WHILE i < n DO
  19.             INC(i); Display.ReplConstC(f, col, sp.u[i] + x0, sp.v[i] + y0, 4, 4, 0)
  20.         END
  21.     END mark;
  22.     PROCEDURE markOrg(f: GraphicFrames.Frame; col, x, y: INTEGER; sp: Spline);
  23.     BEGIN INC(x, sp.u[0]); INC(y, sp.v[0]);
  24.         Display.ReplConstC(f, col, x, y, 4, 4, 0)
  25.     END markOrg;
  26.     PROCEDURE ShowPoly(f: GraphicFrames.Frame; col: INTEGER; VAR p, q: Poly; lim: REAL);
  27.         VAR t: REAL; x, y: LONGINT;
  28.     BEGIN t := 0;
  29.         REPEAT
  30.             Display.DotC(f, col, SHORT(ENTIER(((p.a * t + p.b) * t + p.c) * t + p.d)),
  31.                 SHORT(ENTIER(((q.a * t + q.b) * t + q.c) * t + q.d)), 0);
  32.             t := t + 1.0
  33.         UNTIL t >= lim
  34.     END ShowPoly;
  35.     PROCEDURE SolveTriDiag(VAR a, b, c, y: RealVector; n: INTEGER);
  36.         VAR i: INTEGER;
  37.     BEGIN (*a, b, c of tri-diag matrix T; solve Ty' = y for y', assign y' to y*)
  38.         i := 1;
  39.         WHILE i < n DO y[i] := y[i] - c[i-1]*y[i-1]; INC(i) END ;
  40.         i := n-1; y[i] := y[i]/a[i];
  41.         WHILE i > 0 DO DEC(i); y[i] := (y[i] - b[i]*y[i+1])/a[i] END
  42.     END SolveTriDiag;    
  43.     PROCEDURE OpenSpline(VAR x, y, d: RealVector; n: INTEGER);
  44.         VAR i: INTEGER; d1, d2: REAL;
  45.             a, b, c: RealVector;
  46.     BEGIN (*from x, y compute d = y'*)
  47.         b[0] := 1.0/(x[1] - x[0]); a[0] := 2.0*b[0]; c[0] := b[0];
  48.         d1 := (y[1] - y[0])*3.0*b[0]*b[0]; d[0] := d1; i := 1;
  49.         WHILE i < n-1 DO
  50.             b[i] := 1.0/(x[i+1] - x[i]);
  51.             a[i] := 2.0*(c[i-1] + b[i]);
  52.             c[i] := b[i];
  53.             d2 := (y[i+1] - y[i])*3.0*b[i]*b[i];
  54.             d[i] := d1 + d2; d1 := d2; INC(i)
  55.         END ;
  56.         a[i] := 2.0*b[i-1]; d[i] := d1; i := 0;
  57.         WHILE i < n-1 DO c[i] := c[i]/a[i]; a[i+1] := a[i+1] - c[i]*b[i]; INC(i) END ;
  58.         SolveTriDiag(a, b, c, d, n)
  59.     END OpenSpline;
  60.     PROCEDURE ClosedSpline(VAR x, y, d: RealVector; n: INTEGER);
  61.         VAR i: INTEGER; d1, d2, hn, dn: REAL;
  62.             a, b, c, w: RealVector;
  63.     BEGIN (*from x, y compute d = y'*)
  64.         hn := 1.0/(x[n-1] - x[n-2]);
  65.         dn := (y[n-1] - y[n-2])*3.0*hn*hn;
  66.         b[0] := 1.0/(x[1] - x[0]);
  67.         a[0] := 2.0*b[0] + hn;
  68.         c[0] := b[0];
  69.         d1 := (y[1] - y[0])*3.0*b[0]*b[0]; d[0] := dn + d1;
  70.         w[0] := 1.0; i := 1;
  71.         WHILE i < n-2 DO
  72.             b[i] := 1.0/(x[i+1] - x[i]);
  73.             a[i] := 2.0*(c[i-1] + b[i]);
  74.             c[i] := b[i];
  75.             d2 := (y[i+1] - y[i])*3.0*b[i]*b[i]; d[i] := d1 + d2; d1 := d2;
  76.             w[i] := 0; INC(i)
  77.         END ;
  78.         a[i] := 2.0*b[i-1] + hn; d[i] := d1 + dn;
  79.         w[i] := 1.0; i := 0;
  80.         WHILE i < n-2 DO c[i] := c[i]/a[i]; a[i+1] := a[i+1] - c[i]*b[i]; INC(i) END ;
  81.         SolveTriDiag(a, b, c, d, n-1); SolveTriDiag(a, b, c, w, n-1); 
  82.         d1 := (d[0] + d[i])/(w[0] + w[i] + x[i+1] - x[i]); i := 0;
  83.         WHILE i < n-1 DO d[i] := d[i] - d1*w[i]; INC(i) END ;
  84.         d[i] := d[0]
  85.     END ClosedSpline;
  86.     PROCEDURE CompSpline(f: GraphicFrames.Frame; col, x0, y0: INTEGER; sp: Spline);
  87.         VAR i, n: INTEGER; dx, dy, ds: REAL;
  88.             x, xd, y, yd, s: RealVector;
  89.             p, q: PolyVector;
  90.     BEGIN (*from u, v compute x, y, s*)
  91.         x[0] := sp.u[0] + x0; y[0] := sp.v[0] + y0; s[0] := 0; n := sp.n; i := 1;
  92.         WHILE i < n DO
  93.             x[i] := sp.u[i] + x0; dx := x[i] - x[i-1];
  94.             y[i] := sp.v[i] + y0; dy := y[i] - y[i-1];
  95.             s[i] := ABS(dx) + ABS(dy) + s[i-1]; INC(i)
  96.         END ;
  97.         IF sp.open THEN OpenSpline(s, x, xd, n); OpenSpline(s, y, yd, n)
  98.         ELSE ClosedSpline(s, x, xd, n); ClosedSpline(s, y, yd, n)
  99.         END ;
  100.         (*compute coefficients from x, y, xd, yd, s*)  i := 0;
  101.         WHILE i < n-1 DO
  102.             ds := 1.0/(s[i+1] - s[i]);
  103.             dx := (x[i+1] - x[i])*ds;
  104.             p[i].a := ds*ds*(xd[i] + xd[i+1] - 2.0*dx);
  105.             p[i].b := ds*(3.0*dx - 2.0*xd[i] -xd[i+1]);
  106.             p[i].c := xd[i];
  107.             p[i].d := x[i];
  108.             p[i].t := s[i];
  109.             dy := ds*(y[i+1] - y[i]);
  110.             q[i].a := ds*ds*(yd[i] + yd[i+1] - 2.0*dy);
  111.             q[i].b := ds*(3.0*dy - 2.0*yd[i] - yd[i+1]);
  112.             q[i].c := yd[i];
  113.             q[i].d := y[i];
  114.             q[i].t := s[i]; INC(i)
  115.         END ;
  116.         p[i].t := s[i]; q[i].t := s[i];
  117.         (*display polynomials*)
  118.         i := 0;
  119.         WHILE i < n-1 DO ShowPoly(f, col, p[i], q[i], p[i+1].t - p[i].t); INC(i) END
  120.     END CompSpline;
  121.     PROCEDURE New*;
  122.         VAR sp: Spline;
  123.     BEGIN NEW(sp); sp.do := method; Graphics.new := sp
  124.     END New;
  125.     PROCEDURE Copy(src, dst: Graphics.Object);
  126.     BEGIN dst(Spline)^ := src(Spline)^
  127.     END Copy;
  128.     PROCEDURE Draw(obj: Graphics.Object; VAR M: Graphics.Msg);
  129.         VAR x, y, w, h, col: INTEGER; f: GraphicFrames.Frame;
  130.     BEGIN
  131.         WITH M: GraphicFrames.DrawMsg DO
  132.             x := obj.x + M.x; y := obj.y + M.y; w := obj.w; h := obj.h; f := M.f;
  133.             IF (x < f.X1) & (f.X <= x+w) & (y < f.Y1) & (f.Y <= y+h) THEN
  134.                 IF M.col = Display.black THEN col := obj.col ELSE col := M.col END ;
  135.                 WITH obj: Spline DO
  136.                     IF M.mode = 0 THEN
  137.                         IF obj.selected THEN mark(f, Display.white, x, y, obj) END ;
  138.                         CompSpline(f, col, x, y, obj); markOrg(f, Display.white, x, y, obj)
  139.                     ELSIF M.mode = 1 THEN mark(f, Display.white, x, y, obj)
  140.                     ELSIF M.mode = 2 THEN mark(f, Display.black, x, y, obj)
  141.                     ELSE mark(f, Display.black, x, y, obj);
  142.                         CompSpline(f, Display.black, x, y, obj); markOrg(f, Display.black, x, y, obj)
  143.                     END
  144.                 END
  145.             END
  146.         END
  147.     END Draw;
  148.     PROCEDURE Selectable(obj: Graphics.Object; x, y: INTEGER): BOOLEAN;
  149.         VAR x0, y0: INTEGER;
  150.     BEGIN x0 := obj.x + obj(Spline).u[0]; y0 := obj.y + obj(Spline).v[0];
  151.         RETURN (x0 - 4 <= x) & (x <= x0 + 4) & (y0 - 4 <= y) & (y <= y0 + 4)
  152.     END Selectable;
  153.     PROCEDURE Handle(obj: Graphics.Object; VAR M: Graphics.Msg);
  154.     BEGIN
  155.         IF M IS Graphics.ColorMsg THEN obj.col := M(Graphics.ColorMsg).col END
  156.     END Handle;
  157.     PROCEDURE Read(obj: Graphics.Object; VAR R: Files.Rider; VAR C: Graphics.Context);
  158.         VAR i, j, len: INTEGER; s: SHORTINT;
  159.     BEGIN i := 0; j := 0; Files.ReadInt(R, len);
  160.         WITH obj: Spline DO
  161.             obj.n := (len-1) DIV 4; Files.Read(R, s); obj.open := s=1;
  162.             WHILE i < obj.n DO Files.ReadInt(R, obj.u[i]); INC(i) END;
  163.             WHILE j < obj.n DO Files.ReadInt(R, obj.v[j]); INC(j) END
  164.         END
  165.     END Read;
  166.     PROCEDURE Write(obj: Graphics.Object; cno: SHORTINT; VAR W: Files.Rider; VAR C: Graphics.Context);
  167.         VAR i, j: INTEGER;
  168.     BEGIN i := 0; j := 0;
  169.         WITH obj: Spline DO
  170.             Graphics.WriteObj(W, cno, obj); Files.WriteInt(W, obj.n * 4 + 1);
  171.             IF obj.open THEN Files.Write(W, 1) ELSE Files.Write(W, 0) END ;
  172.             WHILE i < obj.n DO Files.WriteInt(W, obj.u[i]); INC(i) END;
  173.             WHILE j < obj.n DO Files.WriteInt(W, obj.v[j]); INC(j) END
  174.         END
  175.     END Write;
  176.     PROCEDURE Print(obj: Graphics.Object; x, y: INTEGER);
  177.         VAR i, j, n, open: INTEGER;
  178.             u, v: ARRAY N OF INTEGER;
  179.     BEGIN
  180.         WITH obj: Spline DO
  181.             IF obj.open THEN open := 1 ELSE open := 0 END ;
  182.             n := obj.n; i := 0;
  183.             WHILE i < n DO u[i] := obj.u[i]*4; v[i] := obj.v[i]*4; INC(i) END ;
  184.             Printer.Spline(obj.x*4 + x, obj.y*4 + y, n, open, u, v)
  185.         END
  186.     END Print;
  187.     PROCEDURE MakeSpline(open: BOOLEAN);
  188.         VAR x0, x1, x2, y0, y1, y2, i, n: INTEGER;
  189.             spl: Spline;
  190.             G: GraphicFrames.Frame;
  191.             L: GraphicFrames.Location;
  192.     BEGIN G := GraphicFrames.Focus();
  193.         IF (G # NIL) & (G.mark.next # NIL) THEN
  194.             GraphicFrames.Deselect(G);
  195.             NEW(spl); x0 := G.mark.x; y0 := G.mark.y; x1 := x0; y1 := y0;
  196.             spl.u[0] := x0; spl.v[0] := y0; L := G.mark.next; i := 0; n := 1;
  197.             WHILE (L # NIL) & (n < N-1) DO
  198.                 x2 := L.x; spl.u[n] := x2; y2 := L.y; spl.v[n] := y2;
  199.                 IF x2 < x0 THEN x0 := x2 END ;
  200.                 IF x1 < x2 THEN x1 := x2 END ;
  201.                 IF y2 < y0 THEN y0 := y2 END ;
  202.                 IF y1 < y2 THEN y1 := y2 END ;
  203.                 INC(n); L := L.next
  204.             END ;
  205.             WHILE i < n DO DEC(spl.u[i], x0); DEC(spl.v[i], y0); INC(i) END ;
  206.             IF ~open THEN spl.u[n] := spl.u[0]; spl.v[n] := spl.v[0]; INC(n) END ;
  207.             spl.x := x0 - G.x; spl.y :=  y0 - G.y; spl.w := x1 - x0 + 1; spl.h := y1 - y0 + 1;
  208.             spl.open := open; spl.n := n; spl.col := Oberon.CurCol; spl.do := method;
  209.             Graphics.Add(G.graph, spl);
  210.             GraphicFrames.Defocus(G); GraphicFrames.DrawObj(G, spl)
  211.         END
  212.     END MakeSpline;
  213.     PROCEDURE MakeOpen*;
  214.     BEGIN MakeSpline(TRUE)
  215.     END MakeOpen;
  216.     PROCEDURE MakeClosed*;
  217.     BEGIN MakeSpline(FALSE)
  218.     END MakeClosed;
  219. BEGIN NEW(method); method.module := "Splines"; method.allocator := "New";
  220.     method.new := New; method.copy := Copy; method.draw := Draw;
  221.     method.selectable := Selectable; method.handle := Handle;
  222.     method.read := Read; method.write := Write; method.print := Print
  223. END Splines.
  224.